Click Here!
|
Click Here! |
|
| |
       
|
 |
|
To access the contents, click the chapter and section titles.
Bug Proofing Visual Basic: A Guide to Error Handling and Prevention
APPENDIX A
|
|||||||||||||||||||||||||||||||||||||||||||||
| Table A.1 A Typical Daily Schedule |
| 6:30 A.M.–8:30 A.M. | |
| 8:30 A.M.–11:00 A.M. | Program |
| 11:00 A.M.–11:30 A.M. | |
| 11:30 A.M.–12:30 P.M. | Lunch |
| 12:30 P.M.–1:00 P.M. | Email. |
| 1:00 P.M.–2:00 P.M. | Proofread |
| 2:00 P.M.–2:30 P.M. | |
| 2:30 P.M.–4:30 P.M. | Write |
| 4:30 P.M.–5:30 P.M. |
Finally, reading email happens several times during the day. This breaks up big periods of time that I could use for larger tasks like long programming sessions. It also prevents me from seeing how much mail I have all at once. That makes it easy for me to spend a few extra minutes each time I read my email. A few minutes five times a day can really add up.
With these problems in mind, I switched to the schedule shown in Table A.2. Here, writing gets most of my productive hours from 7:00 A.M. to 9:00 A.M. and 1:00 P.M. to 3:00 P.M. Programming gets my remaining precision hours from 9:00 A.M. to 11:30 a.m . Proofreading gets my last productive hours from 3:00 P.M. to 4:00 P.M. Email that is not urgent gets my least-productive time.
This schedule gives me longer periods of uninterrupted time for the most important tasks. It also puts those tasks in the time slots most appropriate for their needs. Consolidating email sessions lets me reduce the total time I spend on email each day, mostly by making it is easier to realize how much time I am spending on it.
Switching to this schedule was not easy. At first I had to set my watch alarm to remind me to move on to the next task, particularly when I was reading email. It took about a week before it became comfortable and a few weeks before I got the new schedule’s full benefit.
An important design mistake in the original version of this code is that the routines ComputeTotal and Prepare use the global variable NumTxt to avoid repeatedly computing the number of controls named Text1. Subroutine Average takes a different approach and computes this value using a local variable.
The program should use one approach or the other, but not both. If it uses a global variable, it should explicitly declare a data type for NumTxt. If it uses local variables, it could make them static and then it would not need to recalculate the value every time each subroutine ran.
| Table A.2 Revised Daily Schedule |
| 6:30 A.M.–7.00 A.M. | Read urgent email only |
| 7:00 A.M.–9:00 A.M. | Write |
| 9:00 A.M.–11:30 A.M. | Program |
| 11:30 A.M.–12:30 P.M. | Lunch |
| 12:30 P.M.–1:00 P.M. | Read urgent email only |
| 1:00 P.M.–2:30 P.M. | Write |
| 2:30 P.M.–3:30 P.M. | Proofread |
| 3:30 P.M.–5:00 P.M. | Read remaining email |
Of course, it would be much better to simply examine the controls in the Text1 control array as in the following code. That does not demonstrate the techniques presented in this chapter, however.
Dim ctl As TextBox
For Each ctl In Text1
:
Next ctl
This code also uses variants extensively. It uses most of them as simple counters that should be declared as integers instead. The original bad version of the code follows. See the notes after the code for explanations of the code’s bad points.
DefInt I-K ‘ 1
Dim NumTxt ‘ 2
Private Sub Command1_Click() ‘ 3
ComputeTotal
End Sub
Private Sub Command2_Click() ‘ 3
Average
End Sub
Private Sub Command3_Click() ‘ 3
Prepare
End Sub
Public Sub Average() ‘ 3
Dim NumTxt ‘ 2, 4
For Each ctl In Form1.Controls ‘ 5, 6
If ctl.Name = “Text1” Then NumTxt = NumTxt + 1 ‘ 7
Next ctl
For i = 0 To NumTxt - 1 ‘ 6
Total = Total + CInt(Text1(i).Text) ‘ 6
Next i
Text2.Text = Format$(Total / NumTxt) ‘ 7
End Sub
Public Sub ComputeTotal() ‘ 3
Dim box As Object ‘ 8
If NumTxt = 0 Then ‘ 5
For Each box In Form1.Controls ‘ 9
If box.Name = “Text1” Then NumTxt = NumTxt + 1 ‘ 7
Next box
End If
For i = 0 To NumTxt - 1 ‘ 6
Total = Total + CInt(Text1(i).Text) ‘ 6
Next i
Text2.Text = Format$(Total) ‘ 7
End Sub
Public Sub Prepare() ‘ 3, 10
Dim box As Object ‘ 8
If NumTxt = 0 Then ‘ 5
For Each box In Form1.Controls ‘ 9
If box.Name = “Text1” Then NumTxt = NumTxt + 1 ‘ 7
Next box
End If
For i = 0 To NumTxt - 1 ‘ 6
Text1(i).Text = Format$(Int(100 * Rnd + 1)) ‘ 7
Next i
End Sub
The improved version of the code follows. Refer to the original version to see what has changed.
Option Explicit
Private mintNumControls As Integer
‘ Calculate and display the average.
Private Sub cmdAverage_Click()
ComputeAverage
End Sub
‘ Randomize the values.
Private Sub cmdRandomize_Click()
RandomizeValues
End Sub
‘ Calculate and display the total.
Private Sub cmdTotal_Click()
ComputeTotal
End Sub
‘ Calculate and display the average of the values
‘ entered in the TextBoxes named txtValue.
Public Sub ComputeAverage()
Dim ctl As Control
Dim i As Integer
Dim total As Integer
‘ If the TextBoxes named txtValue have not yet
‘ been counted, count them.
If mintNumControls = 0 Then
For Each ctl In Controls
If ctl.Name = “txtValue” Then _
mintNumControls = mintNumControls + 1
Next ctl
End If
‘ Add up the values entered in txtValue controls.
For i = 0 To mintNumControls - 1
total = total + CInt(txtValue(i).Text)
Next i
‘ Divide the total by the number of controls
‘ and display the result.
txtResult.Text = Format$(total / mintNumControls)
End Sub
‘ Calculate and display the total of the values
‘ entered in the TextBoxes named txtValue.
Public Sub ComputeTotal()
Dim ctl As Control
Dim i As Integer
Dim total As Integer
‘ If the TextBoxes named txtValue have not yet
‘ been counted, count them.
If mintNumControls = 0 Then
For Each ctl In Controls
If ctl.Name = “txtValue” Then _
mintNumControls = mintNumControls + 1
Next ctl
End If
‘ Add up the values in txtValue controls.
For i = 0 To mintNumControls - 1
total = total + CInt(txtValue(i).Text)
Next i
‘ Display the total.
txtResult.Text = Format$(total)
End Sub
‘ Set the values of the TextBoxes named txtValue
‘ to random numbers between 1 and 100.
Public Sub RandomizeValues()
Dim ctl As Control
Dim i As Integer
‘ If the TextBoxes named txtValue have not yet
‘ been counted, count them.
If mintNumControls = 0 Then
For Each ctl In Controls
If ctl.Name = “txtValue” Then _
mintNumControls = mintNumControls + 1
Next ctl
End If
‘ Generate a random value for each control.
For i = 0 To mintNumControls - 1
txtValue(i).Text = Format$(Int(100 * Rnd + 1))
Next i
End Sub
The original bad version of the code follows. Its most obvious problem is that it uses hard-coded numbers when it should use defined constants. A more subtle problem is that it really should not use constants either. Instead, it should use the txtInput control array’s LBound and UBound properties to determine the proper dimensions for the Values array at runtime. Then you can make the program manipulate more or fewer values simply by creating or removing controls from the form.
The bad version also passes the dimensions of the Values array into the LoadValues, RandomizeValues, and DisplayValues subroutines. Those routines should use Visual Basic’s LBound and UBound functions to determine the array’s bounds directly. See the notes after the code for explanations of the code’s specific bad points.
Option Explicit
Private Values(0 To 9) As String ‘ 1
‘ Randomize the values entered by the user.
Private Sub cmdRandomize_Click()
LoadValues Values, 0, 9 ‘ 1, 2
RandomizeValues Values, 0, 9 ‘ 1, 2
DisplayValues Values, 0, 9 ‘ 1, 2
End Sub
‘ Load the values from the txtInput TextBoxes.
Private Sub LoadValues(list() As String, _
min As Integer, max As Integer) ‘ 2
Dim i As Integer
For i = min To max
list(i) = txtInput(i).Text ‘ 3
Next i
End Sub
‘ Randomize the values in the array.
Private Sub RandomizeValues(list() As String, _
min As Integer, max As Integer) ‘ 2
Dim i As Integer
Dim new_index As Integer
Dim temp_string As String
Randomize
For i = min To max - 1
‘ Randomly pick an entry with index between
‘ i and max to go in position i.
new_index = Int((max - i + 1) * Rnd + i)
‘ Swap that entry with the one in position i.
temp_string = Values(i)
Values(i) = Values(new_index)
Values(new_index) = temp_string
Next i
End Sub
‘ Display the values in the lblOutput Labels.
Private Sub DisplayValues(list() As String, _
min As Integer, max As Integer) ‘ 2
Dim i As Integer
For i = min To max
lblOutput(i).Caption = list(i) ‘ 3
Next i
End Sub
The program should use the LBound and UBound properties provided by the txtInput and lblOutput control arrays to determine the indexes they span. However, there is little need to carry this idea to extremes. The program’s purpose is to randomize a list of values and display the result. It would make no sense for the program to have different numbers of controls in the txtInput and lblOutput arrays.
The program could perform elaborate checks to verify that these arrays hold the same number of controls, but that would be a waste of time. If the arrays contain different numbers of items, the program will crash with an error message that says a control array element does not exist. The message is descriptive enough that you could easily determine the exact problem and fix it.
Similarly, someone could remove one of the controls from the middle of the control arrays. In that case, Visual Basic will again tell you that a control array element does not exist, and you can easily fix the problem.
The following code shows the revised program without magic numbers.
Option Explicit
‘ This array is dimensioned in Form_Load.
Private Values() As String
‘ See how many txtInput controls there are and
‘ redimension the Values array.
Private Sub Form_Load()
Dim min_index As Integer
Dim max_index As Integer
min_index = txtInput.LBound
max_index = txtInput.UBound
ReDim Values(min_index To max_index)
End Sub
‘ Randomize the values entered by the user.
Private Sub cmdRandomize_Click()
LoadValues Values
RandomizeValues Values
DisplayValues Values
End Sub
70
‘ Load the values from the txtInput TextBoxes.
Private Sub LoadValues(list() As String)
Dim i As Integer
For i = LBound(list) To UBound(list)
list(i) = txtInput(i).Text
Next i
End Sub
‘ Randomize the values in the array.
Private Sub RandomizeValues(list() As String)
Dim max_index As Integer
Dim i As Integer
Dim new_index As Integer
Dim temp_string As String
Randomize
max_index = UBound(list)
For i = LBound(list) To max_index - 1
‘ Randomly pick an entry with index between
‘ i and max to go in position i.
new_index = Int((max_index - i + 1) * Rnd + i)
‘ Swap that entry with the one in position i.
temp_string = Values(i)
Values(i) = Values(new_index)
Values(new_index) = temp_string
Next i
End Sub
‘ Display the values in the lblOutput Labels.
Private Sub DisplayValues(list() As String)
Dim i As Integer
For i = LBound(list) To UBound(list)
lblOutput(i).Caption = list(i)
Next i
End Sub
The original version of program Bad5 follows. Its two most obvious problems are that it uses constants and hard-coded values when it could use LBound and UBound, and that it does not verify its data or results. See the notes after the code for explanations of the code’s specific bad points.
Option Explicit
‘ Declare the list of values.
Const NUM_VALUES = 50
Private Values(1 To NUM_VALUES) As Integer
‘ Randomly initialize some values.
Private Sub Form_Load() ‘ 1
InitValues
End Sub
‘ Randomly initialize some values.
Private Sub InitValues()
Dim i As Integer
Dim txt As String
‘ Pick the random values.
Randomize
Values(1) = Int(10 * Rnd + 1)
For i = 2 To NUM_VALUES ‘ 2
Values(i) = Values(i - 1) + Int(10 * Rnd + 1) ‘ 3
Next i
‘ Display the values.
For i = 1 To NUM_VALUES
txt = txt & Format$(i, “@@”) & _
Format$(Values(i), “@@@@”) & vbCrLf
Next i
txtValues.Text = txt
End Sub
‘ Search using the selected method.
Private Sub CmdSearch_Click()
Dim position As Integer
Dim num_searches As Integer
If optSearchMethod(0).Value Then ‘ 4
‘ Linear search.
position = LinearSearch(Values, _
CInt(txtTarget.Text), num_searches) ‘ 5
ElseIf optSearchMethod(1).Value Then
‘ Binary search.
position = BinarySearch(Values, _
CInt(txtTarget.Text), num_searches) ‘ 5
End If
‘ Display the results.
If position = 0 Then
lblPosition.Caption = “Not found”
Else
lblPosition.Caption = Format$(position)
End If
lblSearches.Caption = Format$(num_searches)
End Sub
‘ Use linear binary search to find the target.
Public Function LinearSearch(list() As Integer, _
target As Integer, num_searches As Integer) As Integer
Dim i As Integer
For i = 1 To NUM_VALUES ‘ 2
num_searches = num_searches + 1
If Values(i) = target Then Exit For
Next i
If i <= NUM_VALUES Then
LinearSearch = i
Else
LinearSearch = 0
End If
End Function
‘ Use binary search to find the target. For details
‘ of the algorithm, see Ready-to-Run Visual Basic
‘ Algorithms, ISBN 0-471-24268-3.
Public Function BinarySearch(list() As Integer, _
target As Integer, num_searches As Integer) As Integer
Dim min_index As Integer
Dim max_index As Integer
Dim mid_index As Integer
min_index = 1 ‘ 2
max_index = NUM_VALUES
Do While min_index <= max_index
num_searches = num_searches + 1
mid_index = (min_index + max_index) / 2
If target = list(mid_index) Then
BinarySearch = mid_index
Exit Function
ElseIf target < list(mid_index) Then
max_index = mid_index - 1
Else
min_index = mid_index + 1
End If
Loop
BinarySearch = 0 ‘ 2
End Function
The following code shows a better version of the program. This version does not validate its data when it unloads because that data is never modified after it is initially generated.
Option Explicit
‘ Enabled debugging tests.
#Const DEBUG_MODE = True
‘ Declare the list of values.
Const NUM_VALUES = 50
Private Values(1 To NUM_VALUES) As Integer
‘ Randomly initialize some values.
Private Sub Form_Load()
InitValues
‘ Validate the data.
ValidateList
End Sub
‘ Randomly initialize some values.
Private Sub InitValues()
Const MIN_INCREMENT = 1
Const MAX_INCREMENT = 10
Dim i As Integer
Dim last_value As Integer
Dim txt As String
‘ Pick the random values.
Randomize
For i = LBound(Values) To UBound(Values)
last_value = last_value + _
Int((MAX_INCREMENT - MIN_INCREMENT + 1) * _
Rnd + MIN_INCREMENT)
Values(i) = last_value
Next i
‘ Display the values.
For i = LBound(Values) To UBound(Values)
txt = txt & Format$(i, “@@”) & _
Format$(Values(i), “@@@@”) & vbCrLf
Next i
txtValues.Text = txt
End Sub
‘ Verify that the list is arranged in increasing order.
Private Sub ValidateList()
Dim i As Integer
For i = LBound(Values) + 1 To UBound(Values)
If Values(i - 1) >= Values(i) Then Stop
Next i
End Sub
‘ Search using the selected method.
Private Sub CmdSearch_Click()
Dim target As Integer
Dim position As Integer
Dim num_searches As Integer
target = CInt(txtTarget.Text)
If optSearchMethod(0).Value Then
‘ Linear search.
position = LinearSearch(Values, _
target, num_searches)
ElseIf optSearchMethod(1).Value Then
‘ Binary search.
position = BinarySearch(Values, _
target, num_searches)
Else
‘ This should never happen.
Stop
End If
‘ Display the results.
If position = 0 Then
lblPosition.Caption = “Not found”
Else
lblPosition.Caption = Format$(position)
End If
lblSearches.Caption = Format$(num_searches)
‘ If DEBUG_MODE is true, verify the result.
#If DEBUG_MODE Then
If position <> 0 Then _
VerifyResult target, position
#End If
End Sub
‘ Use linear binary search to find the target.
Public Function LinearSearch(list() As Integer, _
target As Integer, num_searches As Integer) As Integer
Dim i As Integer
For i = LBound(Values) To UBound(Values)
num_searches = num_searches + 1
If Values(i) = target Then Exit For
Next i
If i <= UBound(Values) Then
LinearSearch = i
Else
LinearSearch = LBound(Values) - 1
End If
End Function
‘ Use binary search to find the target. For details
‘ of the algorithm, see Ready-to-Run Visual Basic
‘ Algorithms, ISBN 0-471-24268-3.
Public Function BinarySearch(list() As Integer, _
target As Integer, num_searches As Integer) As Integer
Dim min_index As Integer
Dim max_index As Integer
Dim mid_index As Integer
min_index = LBound(list)
max_index = UBound(list)
Do While min_index <= max_index
num_searches = num_searches + 1
mid_index = (min_index + max_index) / 2
If target = list(mid_index) Then
BinarySearch = mid_index
Exit Function
ElseIf target < list(mid_index) Then
max_index = mid_index - 1
Else
min_index = mid_index + 1
End If
Loop
BinarySearch = LBound(list) - 1
End Function
‘ Verify a search result.
Private Sub VerifyResult(target As Integer, index As Integer)
If Values(index) <> target Then Stop
End Sub
The original version of the Bad6 program follows. It contains several pieces of code that are more difficult to understand than necessary. See the notes after the code for explanations of the code’s specific bad points.
Option Explicit
‘ Make txtOutput as large as possible.
Private Sub Form_Resize()
txtOutput.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
‘ Read the data from the data file.
Private Sub Form_Load() ‘ 1
Dim fnum As Integer
‘ Open the file.
fnum = FreeFile
Open App.Path & “\types.dat” For Input As fnum
‘ Read the data.
LoadData fnum
End Sub
‘ Read the data file and close it.
Sub LoadData(fnum As Integer) ‘ 1, 7
Const FORMAT_SPECIFIER = “!@@@@@@@@@@@@@@@@@@@@”
Dim output_txt As String
Dim all_data As String ‘ 2
Dim next_line As String
Dim token As String
‘ Read all the data.
all_data = Input(LOF(fnum), #fnum) ‘ 3
‘ Start with column headers.
output_txt = _
Format(“Data Type”, FORMAT_SPECIFIER) & _
Format(“Size”, FORMAT_SPECIFIER) & _
Format(“Approx Min”, FORMAT_SPECIFIER) & _
Format(“Approx Max”, FORMAT_SPECIFIER)
output_txt = output_txt & vbCrLf & _
Format(“---------”, FORMAT_SPECIFIER) & _
Format(“----”, FORMAT_SPECIFIER) & _
Format(“----------”, FORMAT_SPECIFIER) & _
Format(“----------”, FORMAT_SPECIFIER) & _
vbCrLf
‘ Read the lines from the file.
Do While Len(all_data) > 0
‘ Get the next line.
next_line = GetToken(all_data, vbCrLf) ‘ 4
‘ Break the line into pieces.
Do While Len(next_line) > 0
token = GetToken(next_line, “;”) ‘ 4, 5
If Len(token) > 0 Then output_txt = output_txt & Format(toke
Loop
output_txt = output_txt & vbCrLf
Loop
‘ Display the result.
txtOutput = output_txt ‘ 6
End Sub
‘ Get the next delimited token from the string txt.
Function GetToken(txt As String, delimiter As String) As String ‘ 4, 7
Dim p As Integer ‘ 8
‘ Find the delimiter.
p = InStr(txt, delimiter)
‘ Get the token.
If p = 0 Then p = Len(txt) + 1 ‘ 9
GetToken = Left(txt, p - 1) ‘ 3
‘ See what‘s left of the string txt.
p = Len(txt) - p + 1 - Len(delimiter) ‘ 10
If p <= 0 Then
txt = “”
Else
txt = Right(txt, p) ‘ 3
End If
End Function
The following code shows a better version of the program. To conserve space, this version still does not contain error handling code.
Option Explicit
‘ Make txtOutput as large as possible.
Private Sub Form_Resize()
txtOutput.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
‘ Read the data from the data file.
Private Sub Form_Load()
Dim fnum As Integer
‘ Open the file.
fnum = FreeFile
Open App.Path & “\types.dat” For Input As fnum
‘ Read the data.
LoadData fnum
‘ Close the file.
Close fnum
End Sub
‘ Read the data file.
Private Sub LoadData(ByVal fnum As Integer)
Const FORMAT_SPECIFIER = “!@@@@@@@@@@@@@@@@@@@@”
Dim output_txt As String
Dim all_data As String
Dim line_data As String
Dim token_data As String
‘ Read all the data.
all_data = Input$(LOF(fnum), #fnum)
‘ Start with column headers.
output_txt = _
Format(“Data Type”, FORMAT_SPECIFIER) & _
Format(“Size”, FORMAT_SPECIFIER) & _
Format(“Approx Min”, FORMAT_SPECIFIER) & _
Format(“Approx Max”, FORMAT_SPECIFIER)
output_txt = output_txt & vbCrLf & _
Format(“---------”, FORMAT_SPECIFIER) & _
Format(“----”, FORMAT_SPECIFIER) & _
Format(“----------”, FORMAT_SPECIFIER) & _
Format(“----------”, FORMAT_SPECIFIER) & _
vbCrLf
‘ Read the lines from the file.
Do While Len(all_data) > 0
‘ Get the next line.
GetToken all_data, line_data, vbCrLf
‘ Break the line into tokens.
Do While Len(line_data) > 0
GetToken line_data, token_data, “;”
If Len(token_data) > 0 Then
output_txt = output_txt & _
Format(token_data, _
FORMAT_SPECIFIER)
End If
Loop
output_txt = output_txt & vbCrLf
Loop
‘ Display the result.
txtOutput.Text = output_txt
End Sub
‘ Get the next delimited token from the text buffer.
‘ Remove the token from the buffer.
Private Sub GetToken(ByRef txt_buffer As String, _
ByRef token As String, ByVal delimiter As String)
Dim delimiter_position As Integer
Dim new_length As Integer
‘ Find the delimiter.
delimiter_position = InStr(txt_buffer, delimiter)
‘ Get the token and see what‘s left of txt_buffer.
If delimiter_position = 0 Then
‘ The delimiter is not present.
‘ Use all of txt_buffer as the token.
token = txt_buffer
txt_buffer = “”
Else
‘ The delimiter is present.
‘ Compute token and see what‘s left
‘ of txt_buffer.
token = Left$(txt_buffer, delimiter_position - 1)
new_length = Len(txt_buffer) - _
delimiter_position + 1 - Len(delimiter)
txt_buffer = Right$(txt_buffer, new_length)
End If
End Sub
The bad version of the comments included at the end of Chapter 7 follows. In general, these comments do not provide much useful information. They tell the reader little that an experienced Visual Basic programmer could not learn by looking at the code. They also do not tell what the routine actually does. See the notes after the example for explanations of specific bad points.
Option Explicit
‘ True when the user is drawing.
Private Drawing As Boolean
‘ Save mouse position. ‘ 1
Private LastX As Single
Private LastY As Single
‘ ************************************************
‘ Purpose: Start drawing. ‘ 2
‘
‘ Method: Use the X and Y coordinates to see where ‘ 3
‘ the mouse currently is.
‘ ************************************************ ‘ 4, 7
Private Sub picDrawingArea_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
‘ Set Drawing to true. ‘ 8
Drawing = True
‘ Record this point‘s location. ‘ 8
LastX = X
LastY = Y
End Sub
‘ ************************************************
‘ Purpose: Process the user‘s mouse move event in ‘ 4
‘ the drawing area.
‘
‘ Method: Use the X and Y coordinates to see where ‘ 2
‘ the mouse currently is.
‘
‘ Errors: ‘ 5
‘ If the user draws outside the drawing area,
‘ raise error OUT_OF_BOUNDS.
‘ ************************************************ ‘ 6
Private Sub picDrawingArea_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
‘ If we are not drawing, BAIL OUT. ‘ 9
If Not Drawing Then Exit Sub
If X < 0 Or _
Y < 0 Or _
X > picDrawingArea.ScaleWidth Or _
Y > picDrawingArea.ScaleHeight _
Then ‘ Make sure we are in the drawing area. ‘ 10
Err.Raise OUT_OF_BOUNDS, _
“picDrawingArea”, _
“Cannot draw outside the drawing area.”
End If
‘ Draw a line from (LastX, LastY) to (X, Y). ‘ 8
picDrawingArea.Line (LastX, LastY)-(X, Y)
‘ Save X and Y. ‘ 8
LastX = X
LastY = Y
End Sub
‘ ************************************************
‘ Purpose: Finish drawing. ‘ 1
‘
‘ Method: Set Drawing to False.
‘ ************************************************ ‘ 6
Private Sub picDrawingArea_MouseUp(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Drawing = False
End Sub
The following code shows an improved version of this code.
Option Explicit
‘ True when the user is drawing.
Private Drawing As Boolean
‘ The last mouse position while drawing.
Private LastX As Single
Private LastY As Single
‘ ************************************************
‘ Purpose: The user pressed the mouse to start
‘ scribbling in the drawing area. Start
‘ drawing.
‘
‘ Method: Set Drawing = True so we process future
‘ MouseMove events to scribble.
‘
‘ Outputs: Sets Drawing = True.
‘ Saves the mouse coordinates in LastX
‘ and LastY.
‘
‘ Asserts: None.
‘
‘ Developer Date Comments
‘ ————- ———— ————
‘ Josh Philps 9/ 6/99 Initial creation.
‘ ************************************************
Private Sub picDrawingArea_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
‘ We are starting to draw.
Drawing = True
‘ Save the mouse position so we can draw
‘ to it later.
LastX = X
LastY = Y
End Sub
‘ ************************************************
‘ Purpose: The user is moving the mouse. If we are
‘ scribbling, continue drawing.
‘
‘ Method: If Drawing = True, draw a line from the
‘ previous point to this one.
‘
‘ Outputs: Saves the new mouse coordinates in
‘ LastX and LastY.
‘
‘ Asserts: None.
‘
‘ Developer Date Comments
‘ ---------- -------- --------
‘ Josh Philps 9/ 6/99 Initial creation.
‘ ************************************************
Private Sub picDrawingArea_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
‘ If we are not drawing, do nothing.
If Not Drawing Then Exit Sub
‘ Draw a line from the last mouse position.
picDrawingArea.Line (LastX, LastY)-(X, Y)
‘ Save the new mouse position so we can draw
‘ to it later.
LastX = X
LastY = Y
End Sub
‘ ************************************************
‘ Purpose: The user released the mouse to stop
‘ scribbling. If we are scribbling, stop.
‘
‘ Method: Set Drawing to False so we ignore
‘ future MouseMove events.
‘
‘ Outputs: Sets Drawing = False.
‘
‘ Asserts: None.
‘
‘ Developer Date Comments
‘ ---------- -------- --------
‘ Josh Philps 9/ 6/99 Initial creation.
‘ ************************************************
Private Sub picDrawingArea_MouseUp(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Drawing = False
End Sub
The broken version of program Bad8 is show in the following code. Its main problems are that it does not properly control the data types it uses. This causes worthless comparisons between strings and doubles and gives rounding errors that make the program fail to find target numbers in almost every case. See the notes after the code for explanations of specific bad points.
Option Explicit
‘ The list of values.
Private Const NUM_VALUES = 50
Private Values(1 To NUM_VALUES) As Variant ‘ 1
‘ Initialize the data.
Private Sub Form_Load()
InitializeData
End Sub
‘ Create some random data.
Private Sub InitializeData()
Dim i As Integer
Dim last_value As Integer ‘ The last value assigned. ‘ 2
Dim txt As String
Randomize
‘ Initialize the random numbers with each
‘ value slightly bigger than the previous one.
last_value = 10
For i = 1 To NUM_VALUES
Values(i) = last_value + Rnd + 0.01 ‘ 3
last_value = Values(i)
Next i
‘ Display the values.
For i = 1 To NUM_VALUES
txt = txt & Format$(i, “@@”) & “: ” & _
Format$(Values(i), “0.000”) & vbCrLf ‘ 4
Next i
txtValues.Text = txt
End Sub
‘ Search for the target.
Private Sub CmdSearch_Click()
Dim position As Integer
position = LinearSearch(Values, txtTarget.Text) ‘ 5
If position < 1 Then
lblPosition.Caption = “Not found”
Else
lblPosition.Caption = Format$(position)
End If
End Sub
‘ Locate a target item using linear search. If the
‘ target is not found, return 1 less than the
‘ smallest array index.
Public Function LinearSearch(list() As Variant, _
target As Variant) As Integer
Dim i As Integer
For i = LBound(list) To UBound(list)
‘ See if we found the target.
If list(i) = target Then ‘ 6
LinearSearch = i
Exit Function
End If
‘ If the values are too big, we passed
‘ where it should be so it‘s not here.
If list(i) > target Then Exit For ‘ 7
Next i
End Function ‘ 8
The following code shows a better version of the program. Because the numbers are shown with a precision of three decimal places, the program checks whether the target value differs from a list value by no more than 0.0005. If so, the list value is identical to the target to within three decimal places.
Option Explicit
‘ The list of values.
Private Const NUM_VALUES = 50
Private Values(1 To NUM_VALUES) As Single
‘ Initialize the data.
Private Sub Form_Load()
InitializeData
End Sub
‘ Create some random data.
Private Sub InitializeData()
Dim i As Integer
Dim last_value As Single ‘ The last value assigned.
Dim txt As String
Randomize
‘ Initialize the random numbers with each
‘ value slightly bigger than the previous one.
last_value = 10
For i = 1 To NUM_VALUES
Values(i) = last_value + Rnd + 0.01
last_value = Values(i)
Next i
‘ Display the values.
For i = 1 To NUM_VALUES
txt = txt & Format$(i, “@@”) & “: ” & _
Format$(Values(i), “0.000”) & vbCrLf
Next i
txtValues.Text = txt
End Sub
‘ Search for the target.
Private Sub CmdSearch_Click()
Dim position As Integer
position = LinearSearch(Values, CSng(txtTarget.Text))
If position < 1 Then
lblPosition.Caption = “Not found”
Else
lblPosition.Caption = Format$(position)
End If
End Sub
‘ Locate a target item using linear search. If the
‘ target is not found, return 1 less than the
‘ smallest array index.
Public Function LinearSearch(list() As Single, _
target As Single) As Integer
Dim i As Integer
For i = LBound(list) To UBound(list)
‘ See if we found the target.
If Abs(list(i) - target) <= 0.0005 Then
LinearSearch = i
Exit Function
End If
‘ If the values are too big, we passed
‘ where it should be so it‘s not here.
If list(i) > target Then Exit For
Next i
‘ We didn‘t find the target.
LinearSearch = LBound(list) - 1
End Function
The code for program Bad9 follows. This program’s main failing is that it was designed in a nonuniform way. The design treats the bold property differently than the italic, underlined, and strikethrough properties even though they are conceptually very similar. It also treats the dissimilar commands Find, Find Relative, bold, unbold, and color uniformly even though they represent very different concepts. These mistakes give the program a confusing user interface and the underlying code is confused to match. See the notes following the code for more specific comments.
Option Explicit
Private Const cmd_FIND = 0
Private Const cmd_FIND_RELATIVE = 1
Private Const cmd_BOLD = 2
Private Const cmd_UNBOLD = 3
Private Const cmd_COLOR = 4
Private Const chk_UNDERLINE = 0
Private Const chk_ITALIC = 1
Private Const chk_STRIKETHROUGH = 2
‘ True when the program is changing display values.
Private SettingValues As Boolean
‘ Apply the selected command.
Private Sub cmdApply_Click() ‘ 1
If optCommand(cmd_FIND) Then ‘ 2
‘ Find and select the indicated text.
FindText
ElseIf optCommand(cmd_FIND_RELATIVE) Then
‘ Find and select the indicated text.
FindTextRelative
ElseIf optCommand(cmd_BOLD) Then
‘ Color the selection bold.
ColorSelection “Bold”
ElseIf optCommand(cmd_UNBOLD) Then
‘ Unbold the selection.
rchMainText.SelBold = False
ElseIf optCommand(cmd_COLOR) Then
‘ Color the selection.
ColorSelection cboSelColor.Text
End If
rchMainText.SetFocus
End Sub
‘ Find and select the indicated text.
Private Sub FindText()
Dim txt As String
Dim pos As Integer
txt = rchMainText.Text
pos = InStr(txt, txtFindText.Text)
If pos = 0 Then
Beep
Else
rchMainText.SelStart = pos - 1
rchMainText.SelLength = Len(txtFindText.Text)
End If
End Sub
‘ Find and select the indicated text skipping the
‘ indicated number of copies.
Private Sub FindTextRelative() ‘ 3
Dim txt As String
Dim target As String
Dim targetlen As Integer
Dim pos As Integer
Dim skip As Integer
Dim trials As Integer
txt = rchMainText.Text
target = txtFindText.Text
skip = CInt(txtSkip.Text)
‘ If skip >= 0, search forward from here.
If skip >= 0 Then
pos = rchMainText.SelStart + 1
For trials = 0 To skip
pos = InStr(pos + 1, txt, target)
If pos = 0 Then Exit For
Next trials
If pos = 0 Then
Beep
Else
rchMainText.SelStart = pos - 1
rchMainText.SelLength = Len(txtFindText.Text)
End If
Else
‘ Skip < 0. Search backwards.
targetlen = Len(target)
trials = 0
skip = -skip
For pos = rchMainText.SelStart To 1 Step -1
If Mid$(txt, pos, targetlen) = target Then
trials = trials + 1
If trials >= skip Then Exit For
End If
Next pos
If pos <= 0 Then
‘ We didn‘t find it.
Beep
Else
rchMainText.SelStart = pos - 1
rchMainText.SelLength = targetlen
End If
End If
End Sub
‘ Color the selected text.
Private Sub ColorSelection(color As String) ‘ 4
Select Case color ‘ 2
Case “Red”
rchMainText.SelColor = vbRed
Case “Green”
rchMainText.SelColor = vbGreen
Case “Blue”
rchMainText.SelColor = vbBlue
Case “Black”
rchMainText.SelColor = vbBlack
Case “Bold”
rchMainText.SelBold = True
End Select
End Sub
‘ Switch the value of the font‘s property.
Private Sub chkFontOption_Click(Index As Integer)
Dim value As Integer
‘ Ignore the event if the program is making the change.
If SettingValues Then Exit Sub
value = (chkFontOption(Index).value = vbChecked)
Select Case Index
Case chk_UNDERLINE
rchMainText.SelUnderline = value
Case chk_ITALIC
rchMainText.SelItalic = value
Case chk_STRIKETHROUGH
rchMainText.SelStrikeThru = value
End Select
rchMainText.SetFocus
End Sub
‘ Update the check boxes.
Private Sub rchMainText_SelChange() ‘ 5
‘ Do not trigger a click event.
SettingValues = True
‘ Check the SelUnderline property.
Select Case rchMainText.SelUnderline
Case True
chkFontOption(chk_UNDERLINE).value = vbChecked
Case False
chkFontOption(chk_UNDERLINE).value = vbUnchecked
Case Else ‘ More than one value.
chkFontOption(chk_UNDERLINE).value = vbGrayed
End Select
‘ Check the SelItalic property.
Select Case rchMainText.SelItalic
Case True
chkFontOption(chk_ITALIC).value = vbChecked
Case False
chkFontOption(chk_ITALIC).value = vbUnchecked
Case Else ‘ More than one value.
chkFontOption(chk_ITALIC).value = vbGrayed
End Select
‘ Check the SelStrikeThru property.
Select Case rchMainText.SelStrikeThru
Case True
chkFontOption(chk_STRIKETHROUGH).value = vbChecked
Case False
chkFontOption(chk_STRIKETHROUGH).value = vbUnchecked
Case Else ‘ More than one value.
chkFontOption(chk_STRIKETHROUGH).value = vbGrayed
End Select
SettingValues = False
End Sub
Figure A.1 shows an improved version of the program. This program treats bold, italic, underline, strikethrough, and color all uniformly as text attributes. The form has been modified to make that clear to the user. The resulting program has a simpler interface and simpler code.
The following code shows the improved version of this program.
Option Explicit Private Const chk_UNDERLINE = 0
)
Figure A.1 Program Good9 uses a simplified user interface.
){kind=link}
Private Const chk_ITALIC = 1
Private Const chk_STRIKETHROUGH = 2
Private Const chk_BOLD = 3
‘ True when the program is changing display values.
Private SettingValues As Boolean
‘ Find and select the indicated text starting from
‘ the beginning of the text.
Private Sub cmdFind_Click()
FindText 1
End Sub
‘ Find and select the indicated text starting from
‘ the selected position + 1.
Private Sub cmdFindNext_Click()
FindText rchMainText.SelStart + 2
End Sub
‘ Find and select the indicated text.
Private Sub FindText(start_pos As Integer)
Dim txt As String
Dim pos As Integer
txt = rchMainText.Text
pos = InStr(start_pos, txt, txtFindText.Text)
If pos = 0 Then
Beep
Else
rchMainText.SelStart = pos - 1
rchMainText.SelLength = Len(txtFindText.Text)
End If
rchMainText.SetFocus
End Sub
‘ Set the selected text‘s color.
Private Sub cboSelColor_Click()
If SettingValues Then Exit Sub
Select Case cboSelColor.Text
Case “Red”
rchMainText.SelColor = vbRed
Case “Green”
rchMainText.SelColor = vbGreen
Case “Blue”
rchMainText.SelColor = vbBlue
Case “Black”
rchMainText.SelColor = vbBlack
Case Else
‘ This should never happen.
Stop
End Select
rchMainText.SetFocus
End Sub
‘ Switch the value of the font‘s property.
Private Sub chkFontOption_Click(Index As Integer)
Dim property_value As Integer
‘ Ignore the event if we are doing it.
If SettingValues Then Exit Sub
property_value = (chkFontOption(Index).Value = vbChecked)
Select Case Index
Case chk_UNDERLINE
rchMainText.SelUnderline = property_value
Case chk_ITALIC
rchMainText.SelItalic = property_value
Case chk_STRIKETHROUGH
rchMainText.SelStrikeThru = property_value
Case chk_BOLD
rchMainText.SelBold = property_value
Case Else
‘ This should never happen.
Stop
End Select
rchMainText.SetFocus
End Sub
‘ Update the check boxes.
Private Sub rchMainText_SelChange()
‘ Do not trigger a click event.
SettingValues = True
‘ Check the correct text style check boxes.
CheckProperty rchMainText.SelUnderline, chkFontOption(chk_UNDERLINE)
CheckProperty rchMainText.SelItalic, chkFontOption(chk_ITALIC)
CheckProperty rchMainText.SelStrikeThru, _
chkFontOption(chk_STRIKETHROUGH)
CheckProperty rchMainText.SelBold, chkFontOption(chk_BOLD)
‘ Display the correct color.
CheckColor
SettingValues = False
End Sub
‘ Set an option‘s checked value based on a text
‘ property value.
Private Sub CheckProperty(property_value As Variant, chk As CheckBox)
Select Case property_value
Case True
chk.Value = vbChecked
Case False
chk.Value = vbUnchecked
Case Else ‘ More than one value.
chk.Value = vbGrayed
End Select
End Sub
‘ Display the color of the selected text.
Private Sub CheckColor()
Select Case rchMainText.SelColor
Case vbRed
cboSelColor.Text = “Red”
Case vbGreen
cboSelColor.Text = “Green”
Case vbBlue
cboSelColor.Text = “Blue”
Case vbBlack
cboSelColor.Text = “Black”
Case Else ‘ More than one color.
‘ Select nothing.
cboSelColor.ListIndex = -1
End Select
End Sub
Program Bad10’s biggest problem is that it does not encapsulate the data that represents the items in the stack. The data values are stored directly in arrays within the main program. That means every routine that uses the stack must understand how the stack works. Later, if you decide to store the stack in a linked list instead of an array, you need to modify all of the routines that use the stack. This will be a lot of work and will give you lots of chances to make mistakes and create bugs.
The program also violates some other encapsulation guidelines in smaller ways. See the notes following the code for more specific comments.
Option Explicit
‘ The data for a person.
Private NumPeople As Integer
Private LastNames() As String ‘ 1
Private FirstNames() As String
‘ Add an item to the stack.
Private Sub cmdPush_Click()
‘ Create space for the new person.
ReDim Preserve LastNames(1 To NumPeople + 1) ‘ 2
ReDim Preserve FirstNames(1 To NumPeople + 1)
‘ Save the new person‘s data.
LastNames(NumPeople + 1) = txtLastName.Text
FirstNames(NumPeople + 1) = txtFirstName.Text
txtLastName.Text = “”
txtFirstName.Text = “”
‘ Enable the Pop button.
cmdPop.Enabled = True
‘ Update the number of people.
NumPeople = NumPeople + 1
‘ Display the list.
DisplayList
End Sub
‘ Remove the top item from the stack.
Private Sub cmdPop_Click()
‘ Display the person‘s values.
txtLastName.Text = LastNames(NumPeople)
txtFirstName.Text = FirstNames(NumPeople)
‘ Remove the last person.
If NumPeople - 1 > 0 Then
ReDim Preserve LastNames(1 To NumPeople - 1) ‘ 3
ReDim Preserve FirstNames(1 To NumPeople - 1)
Else
Erase LastNames
Erase FirstNames
End If
‘ Enable this button only if there are
‘ people left.
cmdPop.Enabled = (NumPeople - 1 > 0)
‘ Save the new number of people.
NumPeople = NumPeople - 1
‘ Display the list.
DisplayList
End Sub
‘ Display the people in the stack.
Private Sub DisplayList()
Dim i As Integer
Dim txt As String
For i = 1 To NumPeople
txt = LastNames(i) & “, ” & _
FirstNames(i) & _
vbCrLf & txt
Next i
txtList.Text = txt
‘ The last name field is where the user will
‘ start editing the new data.
txtLastName.SetFocus
End Sub
The following version of this program encapsulates the stack operations in the PersonStack class. Making the stack a class lets the program create new person stacks quickly and easily. In the previous version of the program, creating a new stack would be quite difficult. The program would need separate arrays and separate routines to manipulate the arrays for each stack. Using a class, creating a new stack is a simple matter of creating a new PersonStack object.
The PersonStack class encapsulates person data in the Person user-defined type. This UDT is used only by the PersonStack class to manage the stack. Because the rest of the program does not need to use the Person UDT, it is declared privately in the PersonStack class module.
‘ ****************
‘ File: Good10.frm
‘ ****************
Option Explicit
‘ The stack object.
Private TheStack As New PersonStack
‘ Add an item to the stack.
Private Sub cmdPush_Click()
‘ Save the new person‘s data.
TheStack.Push txtLastName.Text, txtFirstName.Text
txtLastName.Text = “”
txtFirstName.Text = “”
‘ Enable the Pop button.
cmdPop.Enabled = True
‘ Display the list.
txtList.Text = TheStack.TextRepresentation
txtLastName.SetFocus
End Sub
‘ Remove the top item from the stack.
Private Sub cmdPop_Click()
Dim last_name As String
Dim first_name As String
‘ Display the person‘s values.
TheStack.Pop last_name, first_name
txtLastName.Text = last_name
txtFirstName.Text = first_name
‘ Enable this button only if there are
‘ people left.
cmdPop.Enabled = (TheStack.NumPersons > 0)
‘ Display the list.
txtList.Text = TheStack.TextRepresentation
txtLastName.SetFocus
End Sub
‘ ****************
‘ File: Person.cls
‘ ****************
Option Explicit
‘ UDT to represent a person.
Private Type Person
perLastName As String
perFirstName As String
End Type
‘ The stack array.
Private NumPeople As Integer
Private People() As Person
‘ Add a person to the stack.
Public Sub Push(ByVal last_name As String, ByVal first_name As String)
‘ Update the number of people.
NumPeople = NumPeople + 1
‘ Create space for the new person.
ReDim Preserve People(1 To NumPeople)
‘ Save the new person‘s data.
With People(NumPeople)
.perLastName = last_name
.perFirstName = first_name
End With
End Sub
‘ Remove the top person from the stack. Return
‘ that person‘s data through parameters.
Public Sub Pop(last_name As String, first_name As String)
‘ Get the last person‘s data.
With People(NumPeople)
last_name = .perLastName
first_name = .perFirstName
End With
‘ Update the number of people.
NumPeople = NumPeople - 1
‘ Remove the last person.
If NumPeople > 0 Then
ReDim Preserve People(1 To NumPeople)
Else
Erase People
End If
End Sub
‘ Return the number of people in the stack.
Public Property Get NumPersons() As Integer
NumPersons = NumPeople
End Property
‘ Return a textual representation of the stack.
Public Function TextRepresentation() As String
Dim i As Integer
Dim txt As String
For i = 1 To NumPeople
With People(i)
txt = .perLastName & “, ” & _
.perFirstName & _
vbCrLf & txt
End With
Next i
TextRepresentation = txt
End Function
The problem with program Bad11 is that it may sometimes try to access array elements with indexes outside the array’s bounds. Even though integer overflow checks are disabled, overflow is not a problem because the CInt function raises overflow errors even if integer overflow checks are disabled. See the notes following the code for more specific comments.
Option Explicit
Private Values(1 To 100) As Single
Private Sub cmdGet_Click()
Dim index As Integer
On Error GoTo GetError
index = CLng(txtIndex.Text) ‘ 1
txtValue.Text = Format$(CellValue(index))
Exit Sub
GetError:
MsgBox “Error” & Str$(Err.Number) & _
“ getting value.” & vbCrLf & _
Err.Description
End Sub
Private Sub cmdSet_Click()
On Error GoTo SetError
CellValue(txtIndex.Text) = txtValue.Text ‘ 2
Exit Sub
SetError:
MsgBox “Error” & Str$(Err.Number) & _
“ setting value.” & vbCrLf & _
Err.Description
End Sub
‘ Return the indicated array cell value.
Public Property Get CellValue(ByVal index As Integer) As Single
CellValue = Values(index) ‘ 3
End Property
‘ Set the indicated array cell value.
Public Property Let CellValue(ByVal index As Integer, _
new_value As Single) ‘ 4
Values(index) = new_value ‘ 3
End Property
The following version of the code has been modified so it is safe for all of the optimizations. Note that the changes may slow the program enough to remove any advantage given by the optimizations.
Option Explicit
Private Values(1 To 100) As Single
Private Sub cmdGet_Click()
Dim index As Integer
Dim value As Single
On Error GoTo GetError
index = CInt(txtIndex.Text)
txtValue.Text = Format$(CellValue(index))
Exit Sub
GetError:
MsgBox “Error” & Str$(Err.Number) & _
“ getting value.” & vbCrLf & _
Err.Description
End Sub
Private Sub cmdSet_Click()
On Error GoTo SetError
CellValue(txtIndex.Text) = txtValue.Text
Exit Sub
SetError:
MsgBox “Error” & Str$(Err.Number) & _
“ setting value.” & vbCrLf & _
Err.Description
End Sub
‘ Return the indicated array cell value.
Public Property Get CellValue(ByVal index As Integer) As Single
‘ Make sure the index is valid.
If index < 1 Or index > 100 Then _
Err.Raise 9, “Good11.CellValue”, _
“Subscript out of range”
CellValue = Values(index)
End Property
‘ Set the indicated array cell value.
Public Property Let CellValue(ByVal index As Integer, _
ByVal new_value As Single)
‘ Make sure the index is valid.
If index < 1 Or index > 100 Then _
Err.Raise 9, “Good11.CellValue”, _
“Subscript out of range”
Values(index) = new_value
End Property
Program Bad12 includes no error handling whatsoever. That makes it vulnerable to a couple kinds of errors. When the user resizes the form, the program tries to make its controls as big as possible. If the form is minimized or reduced to a very small height, the program tries to give some controls negative heights and crashes. The program also crashes if it is asked to display a nongraphic file.
The original bad version of the code follows. See the notes after the code for more specific comments.
Option Explicit
‘ Load cboPatterns with file selection patterns.
Private Sub Form_Load() ‘ 1
cboPatterns.AddItem “Bitmaps (*.bmp)”
cboPatterns.AddItem “GIF (*.gif)”
cboPatterns.AddItem “JPEG (*.jpg)”
cboPatterns.AddItem “Graphic (*.bmp;*.gif;*.jpg)”
cboPatterns.AddItem “All Files (*.*)”
‘ Start with the first choice (bitmaps) selected.
cboPatterns.ListIndex = 0
End Sub
‘ Make the controls as big as possible.
Private Sub Form_Resize() ‘ 1
Const GAP = 60
Dim wid As Integer
Dim hgt As Integer
‘ Put drvDrives at the top.
wid = drvDrives.Width
drvDrives.Move GAP, GAP, wid
‘ Put cboPatterns at the bottom.
cboPatterns.Move GAP, ScaleHeight - cboPatterns.Height, wid
‘ Make dirDirectories and filFiles split the
‘ rest of the available height.
hgt = (cboPatterns.Top - drvDrives.Top - _
drvDrives.Height - 3 * GAP) / 2 ‘ 2
dirDirectories.Move GAP, drvDrives.Top + _
drvDrives.Height + GAP, wid, hgt
filFiles.Move GAP, dirDirectories.Top + _
dirDirectories.Height + GAP, wid, hgt
End Sub
‘ The user selected a new pattern.
‘ Make filFiles use the selected pattern to list files.
Private Sub cboPatterns_Click() ‘ 1
Dim choice As String
Dim file_pattern As String
Dim start_pos As Integer
Dim end_pos As Integer
‘ Find the pattern between parentheses.
choice = cboPatterns.List(cboPatterns.ListIndex)
start_pos = InStr(choice, “(”)
end_pos = InStr(choice, “)”)
file_pattern = Mid$(choice, start_pos + 1, _
end_pos - start_pos - 1)
filFiles.Pattern = file_pattern
End Sub
‘ The user has picked a new drive.
‘ Update the directory list.
Private Sub drvDrives_Change() ‘ 1
dirDirectories.Path = drvDrives.Drive ‘ 3
End Sub
‘ The user has picked a new directory.
‘ Update the file list.
Private Sub dirDirectories_Change() ‘ 1
filFiles.Path = dirDirectories.Path
End Sub
‘ The user has picked a file.
‘ Display it.
Private Sub filFiles_Click() ‘ 1
Dim fname As String
‘ Display the selected file‘s full name
‘ in the form‘s caption.
fname = filFiles.Path + “\” + filFiles.filename
Caption = “Picture Viewer [” & fname & “]”
‘ Display the picture.
MousePointer = vbHourglass
DoEvents
imgView.Picture = LoadPicture(fname) ‘ 4
MousePointer = vbDefault
End Sub
The following code has been modified so it checks for all known and unknown errors. The program will continue to run even if an unexpected situation arises.
Option Explicit
‘ Set to False in the compiled version.
Private Const DEBUG_MODE = True
‘ Load cboPatterns with file selection patterns.
Private Sub Form_Load()
On Error GoTo LoadError
cboPatterns.AddItem “Bitmaps (*.bmp)”
cboPatterns.AddItem “GIF (*.gif)”
cboPatterns.AddItem “JPEG (*.jpg)”
cboPatterns.AddItem “Graphic (*.bmp;*.gif;*.jpg)”
cboPatterns.AddItem “All Files (*.*)”
‘ Start with the first choice (bitmaps) selected.
cboPatterns.ListIndex = 0
Exit Sub
LoadError:
‘ There are no known ways this routine can fail.
‘ At design time, stop so we can fix the bug.
‘ In the compiled version, continue.
If DEBUG_MODE Then Stop
Resume Next
End Sub
‘ Make the controls as big as possible.
Private Sub Form_Resize()
Const GAP = 60
Dim wid As Integer
Dim hgt As Integer
On Error GoTo ResizeError
‘ Do nothing if the form is minimized.
If WindowState = vbMinimized Then Exit Sub
‘ Put drvDrives at the top.
wid = drvDrives.Width
drvDrives.Move GAP, GAP, wid
‘ Put cboPatterns at the bottom.
cboPatterns.Move GAP, ScaleHeight - cboPatterns.Height, wid
‘ Make dirDirectories and filFiles split the
‘ rest of the available height.
hgt = (cboPatterns.Top - drvDrives.Top - _
drvDrives.Height - 3 * GAP) / 2
If hgt < 100 Then hgt = 100
dirDirectories.Move GAP, drvDrives.Top + _
drvDrives.Height + GAP, wid, hgt
filFiles.Move GAP, dirDirectories.Top + _
dirDirectories.Height + GAP, wid, hgt
Exit Sub
ResizeError:
‘ There are no known ways this routine can fail.
‘ At design time, stop so we can fix the bug.
‘ In the compiled version, continue.
If DEBUG_MODE Then Stop
Resume Next
End Sub
‘ The user selected a new pattern.
‘ Make filFiles use the selected pattern to list files.
Private Sub cboPatterns_Click()
Dim choice As String
Dim file_pattern As String
Dim start_pos As Integer
Dim end_pos As Integer
On Error GoTo NewPatternError
‘ Find the pattern between parentheses.
choice = cboPatterns.List(cboPatterns.ListIndex)
start_pos = InStr(choice, “(”)
end_pos = InStr(choice, “)”)
file_pattern = Mid$(choice, start_pos + 1, _
end_pos - start_pos - 1)
filFiles.Pattern = file_pattern
Exit Sub
NewPatternError:
‘ There are no known ways this routine can fail.
‘ At design time, stop so we can fix the bug.
‘ In the compiled version, continue.
If DEBUG_MODE Then Stop
Resume Next
End Sub
‘ The user has picked a new drive.
‘ Update the directory list.
Private Sub drvDrives_Change()
On Error GoTo DriveError
dirDirectories.Path = drvDrives.Drive
Exit Sub
DriveError:
If MsgBox(“Drive ” & drvDrives.Drive & _
“ is unavailable. Try again?”, _
vbRetryCancel, “Drive Unavailable”) _
= vbRetry _
Then
‘ Try again. The user may have inserted
‘ a missing floppy disk or CD-ROM.
Resume
End If
‘ Keep the previously selected drive.
drvDrives.Drive = dirDirectories.Path
Exit Sub
End Sub
‘ The user has picked a new directory.
‘ Update the file list.
Private Sub dirDirectories_Change()
On Error GoTo DirectoryError
filFiles.Path = dirDirectories.Path
Exit Sub
DirectoryError:
‘ There are no known ways this routine can fail.
‘ At design time, stop so we can fix the bug.
‘ In the compiled version, continue.
If DEBUG_MODE Then Stop
Resume Next
End Sub
‘ The user has picked a file.
‘ Display it.
Private Sub filFiles_Click()
Dim fname As String
On Error GoTo LoadPictureError
‘ Display the selected file‘s full name
‘ in the form‘s caption.
fname = filFiles.Path
If Right$(fname, 1) <> “\” Then fname = fname & “\”
fname = fname & filFiles.filename
Caption = “Picture Viewer [” & fname & “]”
‘ Display the picture.
MousePointer = vbHourglass
DoEvents
imgView.Picture = LoadPicture(fname)
MousePointer = vbDefault
Exit Sub
LoadPictureError:
If Err.Number = 481 Then
‘ The picture failed to load. This is an
‘ expected error but not a bug. Let the user know
‘ the file could not be loaded and continue.
Beep
Caption = “Picture Viewer [Invalid picture]”
Set imgView.Picture = Nothing
Else
‘ This is an unknown error.
‘ There are no other known ways this routine can fail.
‘ At design time, stop so we can fix the bug.
‘ In the compiled version, continue.
If DEBUG_MODE Then Stop
End If
‘ Among other things, the Resume Next lets the
‘ code continue until it resets the cursor with:
‘ MousePointer = vbDefault
Resume Next
End Sub
Program Bad13 has a few problems. The main program’s code that follows does not exit before the error handlers. The program enters the error handling code even if it is successful. It also does not let the user know anything is wrong when an error occurs.
While the main program has problems when it succeeds, the error management code has problems when it fails. It does not tell the user if there is a problem saving the error information.
One particularly troublesome case occurs if the prefix directory C:\Errors does not exist. In that case, the first call to the Dir function finds a filename that is not used; unfortunately, it is not used because it is invalid. When the program tries to create the file, it fails. If this directory does not exist, no error messages will ever be saved. For specific comments, see the notes that follow the code.
‘ Calculate the ratio of A / B.
Private Sub cmdCalculate_Click()
Dim A As Single
Dim B As Single
Dim A_over_B As Single
On Error GoTo RaiseErrorError
A = CSng(txtA.Text)
B = CSng(txtB.Text)
A_over_B = A / B
lblAOverB.Caption = Format$(A_over_B, “0.000”)
RaiseErrorError: ‘ 1
SaveErrorToFile _
“Error ” & Format$(Err.number) & _
“ in FileError.cmdRaiseError_Click.” & _
vbCrLf & Err.Description ‘ 2
End Sub
‘ Append mail to an error log file.
Public Sub SaveErrorToFile(ByVal txt As String)
Const FILE_PREFIX = “C:\Errors\err” ‘ 3
Const FILE_SUFFIX = “.txt”
Dim file_name As String
Dim fnum As Integer
Dim trial As Integer
On Error GoTo SaveErrorToFileError
‘ Find a file name we can use.
trial = 1
Do
‘ Compute the next name to try.
file_name = FILE_PREFIX & _
Format$(trial) & FILE_SUFFIX
‘ See if the file exists.
If Dir(file_name) = “” Then Exit Do
trial = trial + 1
Loop
‘ Open the file.
fnum = FreeFile
Open file_name For Append As #fnum ‘ 4
‘ Write the date and time, and the error message.
Print #fnum, Now, txt, “**********” ‘ 5
‘ Close the file.
Close #fnum
Exit Sub
SaveErrorToFileError:
‘ There was an error saving to the file.
‘ Just display the message.
MsgBox txt ‘ 6
Exit Sub
End Sub
This program must cope with two main error conditions: divide by zero errors when B is 0, and conversion errors when A or B are nonnumeric. They are known errors that may be caused by the user. The program should check for those conditions and handle them specifically.
The following code is modified so it handles errors and success more gracefully.
‘ Calculate the ratio of A / B.
Private Sub cmdCalculate_Click()
Dim A As Single
Dim B As Single
Dim A_over_B As Single
On Error GoTo RaiseErrorError
A = CSng(txtA.Text)
B = CSng(txtB.Text)
A_over_B = A / B
lblAOverB.Caption = Format$(A_over_B, “0.000”)
Exit Sub
RaiseErrorError:
‘ Blank the result.
lblAOverB.Caption = “”
‘ See what kind of error it was.
Select Case Err.number
Case 11
‘ Divide by zero.
MsgBox “B must not be zero.”
Exit Sub
Case 13
‘ Type mismatch.
MsgBox “Both arguments must be numeric.”
Exit Sub
Case Else
‘ Tell the user we failed.
MsgBox “Error calculating ratio.”
‘ Save an error message.
SaveErrorToFile _
“Error ” & Format$(Err.number) & _
“ in FileError.cmdRaiseError_Click.” & _
vbCrLf & Err.Description
End Select
End Sub
‘ Append mail to an error log file.
Public Sub SaveErrorToFile(ByVal txt1 As String)
Const FILE_DIRECTORY = “C:\Errors”
Const BACKUP_DIRECTORY = “C:\”
Const FILE_SUFFIX = “.txt”
Dim file_prefix As String
Dim file_name As String
Dim fnum As Integer
Dim trial As Integer
Dim txt2 As String
Dim file_open As Boolean
On Error GoTo SaveErrorToFileError
‘ See if the error directory exists.
If Dir(FILE_DIRECTORY) <> “” Then
file_prefix = FILE_DIRECTORY & “err”
Else
file_prefix = BACKUP_DIRECTORY & “err”
txt1 = txt1 & vbCrLf & _
“Warning: Directory ” & _
FILE_DIRECTORY & _
“ does not exist. Using ” & _
BACKUP_DIRECTORY & “.”
End If
‘ Find a file name we can use.
trial = 1
Do
‘ Compute the next name to try.
file_name = file_prefix & _
Format$(trial) & FILE_SUFFIX
‘ See if the file exists.
If Dir(file_name) = “” Then Exit Do
trial = trial + 1
Loop
‘ Open the file.
fnum = FreeFile
Open file_name For Output As #fnum
file_open = True
‘ Write the date and time, and the error message.
Print #fnum, Now
Print #fnum, txt1
Print #fnum, “**********”
‘ Close the file.
Close #fnum
Exit Sub
SaveErrorToFileError:
‘ There was an error saving to the file.
‘ Just display the message.
txt2 = “Error ” & Format$(Err.number) & _
“ saving error message to file.” & _
vbCrLf & Err.Description
MsgBox txt2 & vbCrLf & vbCrLf & txt1
‘ Close the file if it is open.
If file_open Then Close #fnum
Exit Sub
End Sub
The Calc program available on the book’s Web site performs black box and white box tests. You can use the Test menu’s Black Box and White Box commands to run the tests.
There are two ways the user can enter values into the program: clicking on buttons and pressing keys on the keyboard. For example, to enter a + operator, the user can click the + button or press the + key. Program Calc allows you to determine which type of input to test. Select the Key or Button command from the Tests menu to tell the program which method to use. Then when you run a test, the test routine uses the appropriate input method to send inputs to the program.
The program’s black box test generates random numbers and random operators. It enters the first value, the operator, and the second value. It then sends the equals character and compares the result in the display TextBox with a value the test calculates.
To look for unusual special cases, the program generates three sets of random values. These values are small, medium, and large, and are chosen from the three ranges –1 to 1, –1000000 to 1000000, and –999999999999 to 999999999999.
The white box tests do the following:
These tests were not scientifically generated. They were simply chosen to test unusual special cases that could make the program fail. Despite their ad hoc creation, in some of the early versions of the program these tests were very helpful in pinpointing bugs.
Figure A.2 shows line timing results produced by the Visual Basic Code Profiler for program Bad15. These results show that the program spends almost 80 percent of its time in just two lines in the Crypt subroutine.
ch = Mid$(txtIn.Text, i, 1)
:
txtOut.Text = txtOut.Text & ch
These lines are hit often, but other lines are hit just as often and they do not take a lot of time. The reason these lines are slow is that they reference a control’s properties. Referencing properties is relatively slow.
)
Figure A.2 Line timing results for program Bad15.
An easy way to make this routine much faster is to store these values in string variables instead of using the object properties. When the Crypt routine begins, it stores the value txtIn.Text in a local variable and then uses that variable in the Mid$ statement. It also builds the output string in a local variable and assigns the result to txtOut.Text only when the conversion is finished.
If you are a fairly experienced Visual Basic programmer, you may have known that accessing control properties is slow and guessed that these two lines were the problem. If you did not make this guess and you did not use the code profiler, you might have assumed that the complicated mathematical statements were to blame for the poor performance. You might have wasted a lot of time tuning those lines without making much improvement. You might also have introduced a bug or two.
Making the routine store the two string values in local variables reduces its time to encrypt 1000 characters from around seven seconds to less than one second. The following code shows the two improvements. Because the crypt subroutine contains the program’s only modifications, only it is shown here.
){kind=link}
‘ Encrypt the input text.
Private Sub Crypt(ByVal txtIn As TextBox, ByVal txtOut As TextBox, _
ByVal key As Integer)
Const MIN_ASC = 32 ‘ ASCII code for space.
Const MAX_ASC = 126 ‘ ASCII code for ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim i As Integer
Dim ch As String
Dim ch_num As String
Dim input_text As String
Dim output_text As String
input_text = txtIn.Text
For i = 1 To Len(input_text)
ch = Mid$(input_text, i, 1)
ch_num = Asc(ch)
‘ Translate only printable characters.
If ch_num >= MIN_ASC And ch_num <= MAX_ASC Then
ch_num = ch_num + key - MIN_ASC
ch_num = (ch_num Mod NUM_ASC)
If ch_num < 0 Then ch_num = ch_num + NUM_ASC
ch_num = ch_num + MIN_ASC
End If
ch = Chr$(ch_num)
output_text = output_text & ch
Next i
txtOut.Text = output_text
End Sub
If you use VBCP to run a line timing test on program Bad16, you will find that the program spends more than 95 percent of its time performing 4036 hits on the following statement in the ShadePicture subroutine.
picGraph.Line (0, Y)- _
(picGraph.ScaleWidth, Y), _
RGB(clr, clr, clr)
This line should not be executed so many times. The picGraph control is only a few hundred pixels tall, so the program should not be drawing more than 4000 lines on it. In fact, most computer monitors are only 600 or so pixels tall, so the program should never need to draw more than about 600 lines to completely cover the screen.
The problem with program Bad16 is that the picGraph control’s ScaleMode property is initially set to vbTwips. Recall that there are 1/1440 twips per inch. The computer where I ran this test has 15 twips per pixel. That means the program draws 15 times as many lines as necessary to completely fill the PictureBox.
One solution to this problem would be to make the ShadePicture subroutine change the control’s ScaleMode to vbPixels. Then subroutine ShadePicture would work as it is written. However, this solution violates the intent of the rule “Fix routines, not lines.” Changing this control’s ScaleMode property would make ShadePicture work, but it would break other routines.
This program’s Form_Load event handler calls subroutines LoadData, ShadePicture, and DrawGraph, in that order. LoadData generates data based on the PictureBox’s current size in twips. If ShadePicture changes the ScaleMode to pixels, subroutine DrawGraph will not be able to use the values saved by LoadData.
To fix the bug without introducing a new one, ShadePicture saves the control’s scale properties before it shades the picture. It then restores the scale properties when it is finished. This is the approach taken in the following code. Only the ShadePicture routine needs to be changed, so only it is shown here.
‘ Shade picGraph from white at the top to
‘ black at the bottom.
Private Sub ShadePicture()
Const START_COLOR = 255
Const END_COLOR = 0
Dim Y As Single
Dim clr As Single
Dim d_clr As Single
Dim scale_mode As Integer
Dim scale_left As Single
Dim scale_top As Single
Dim scale_width As Single
Dim scale_height As Single
‘ Save the current scale information.
scale_mode = picGraph.ScaleMode
If scale_mode = vbUser Then
scale_left = picGraph.ScaleLeft
scale_top = picGraph.ScaleTop
scale_width = picGraph.ScaleWidth
scale_height = picGraph.ScaleHeight
End If
‘ Shade using pixels.
picGraph.ScaleMode = vbPixels
d_clr = (END_COLOR - START_COLOR) / picGraph.ScaleHeight
clr = START_COLOR
For Y = 0 To picGraph.ScaleHeight
picGraph.Line (0, Y)- _
(picGraph.ScaleWidth, Y), _
RGB(clr, clr, clr)
clr = clr + d_clr
Next Y
‘ Restore the scale information.
If scale_mode = vbUser Then
picGraph.Scale (scale_left, scale_top)- _
(scale_left + scale_width, _
scale_top + scale_height)
Else
picGraph.ScaleMode = scale_mode
End If
End Sub
| Previous | Table of Contents | Next |
|
Products | Contact Us | About Us | Privacy | Ad Info | Home
Use of this site is subject to certain Terms & Conditions, Copyright © 1996-1999 EarthWeb Inc. All rights reserved. Reproduction whole or in part in any form or medium without express written permision of EarthWeb is prohibited.
|